home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / quadpack / dqpsrt.f < prev    next >
Text File  |  1996-07-19  |  4KB  |  130 lines
  1.       SUBROUTINE DQPSRT(LIMIT,LAST,MAXERR,ERMAX,ELIST,IORD,NRMAX)
  2. C***BEGIN PROLOGUE  DQPSRT
  3. C***REFER TO  DQAGE,DQAGIE,DQAGPE,DQAWSE
  4. C***ROUTINES CALLED  (NONE)
  5. C***REVISION DATE  810101   (YYMMDD)
  6. C***KEYWORDS  SEQUENTIAL SORTING
  7. C***AUTHOR  PIESSENS,ROBERT,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN
  8. C           DE DONCKER,ELISE,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN
  9. C***PURPOSE  THIS ROUTINE MAINTAINS THE DESCENDING ORDERING IN THE
  10. C            LIST OF THE LOCAL ERROR ESTIMATED RESULTING FROM THE
  11. C            INTERVAL SUBDIVISION PROCESS. AT EACH CALL TWO ERROR
  12. C            ESTIMATES ARE INSERTED USING THE SEQUENTIAL SEARCH
  13. C            METHOD, TOP-DOWN FOR THE LARGEST ERROR ESTIMATE AND
  14. C            BOTTOM-UP FOR THE SMALLEST ERROR ESTIMATE.
  15. C***DESCRIPTION
  16. C
  17. C           ORDERING ROUTINE
  18. C           STANDARD FORTRAN SUBROUTINE
  19. C           DOUBLE PRECISION VERSION
  20. C
  21. C           PARAMETERS (MEANING AT OUTPUT)
  22. C              LIMIT  - INTEGER
  23. C                       MAXIMUM NUMBER OF ERROR ESTIMATES THE LIST
  24. C                       CAN CONTAIN
  25. C
  26. C              LAST   - INTEGER
  27. C                       NUMBER OF ERROR ESTIMATES CURRENTLY IN THE LIST
  28. C
  29. C              MAXERR - INTEGER
  30. C                       MAXERR POINTS TO THE NRMAX-TH LARGEST ERROR
  31. C                       ESTIMATE CURRENTLY IN THE LIST
  32. C
  33. C              ERMAX  - DOUBLE PRECISION
  34. C                       NRMAX-TH LARGEST ERROR ESTIMATE
  35. C                       ERMAX = ELIST(MAXERR)
  36. C
  37. C              ELIST  - DOUBLE PRECISION
  38. C                       VECTOR OF DIMENSION LAST CONTAINING
  39. C                       THE ERROR ESTIMATES
  40. C
  41. C              IORD   - INTEGER
  42. C                       VECTOR OF DIMENSION LAST, THE FIRST K ELEMENTS
  43. C                       OF WHICH CONTAIN POINTERS TO THE ERROR
  44. C                       ESTIMATES, SUCH THAT
  45. C                       ELIST(IORD(1)),...,  ELIST(IORD(K))
  46. C                       FORM A DECREASING SEQUENCE, WITH
  47. C                       K = LAST IF LAST.LE.(LIMIT/2+2), AND
  48. C                       K = LIMIT+1-LAST OTHERWISE
  49. C
  50. C              NRMAX  - INTEGER
  51. C                       MAXERR = IORD(NRMAX)
  52. C
  53. C***END PROLOGUE  DQPSRT
  54. C
  55.       DOUBLE PRECISION ELIST,ERMAX,ERRMAX,ERRMIN
  56.       INTEGER I,IBEG,IDO,IORD,ISUCC,J,JBND,JUPBN,K,LAST,LIMIT,MAXERR,
  57.      *  NRMAX
  58.       DIMENSION ELIST(LAST),IORD(LAST)
  59. C
  60. C           CHECK WHETHER THE LIST CONTAINS MORE THAN
  61. C           TWO ERROR ESTIMATES.
  62. C
  63. C***FIRST EXECUTABLE STATEMENT  DQPSRT
  64.       IF(LAST.GT.2) GO TO 10
  65.       IORD(1) = 1
  66.       IORD(2) = 2
  67.       GO TO 90
  68. C
  69. C           THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, DUE TO A
  70. C           DIFFICULT INTEGRAND, SUBDIVISION INCREASED THE ERROR
  71. C           ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE SHOULD
  72. C           START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE.
  73. C
  74.    10 ERRMAX = ELIST(MAXERR)
  75.       IF(NRMAX.EQ.1) GO TO 30
  76.       IDO = NRMAX-1
  77.       DO 20 I = 1,IDO
  78.         ISUCC = IORD(NRMAX-1)
  79. C ***JUMP OUT OF DO-LOOP
  80.         IF(ERRMAX.LE.ELIST(ISUCC)) GO TO 30
  81.         IORD(NRMAX) = ISUCC
  82.         NRMAX = NRMAX-1
  83.    20    CONTINUE
  84. C
  85. C           COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED
  86. C           IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF
  87. C           SUBDIVISIONS STILL ALLOWED.
  88. C
  89.    30 JUPBN = LAST
  90.       IF(LAST.GT.(LIMIT/2+2)) JUPBN = LIMIT+3-LAST
  91.       ERRMIN = ELIST(LAST)
  92. C
  93. C           INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN,
  94. C           STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)).
  95. C
  96.       JBND = JUPBN-1
  97.       IBEG = NRMAX+1
  98.       IF(IBEG.GT.JBND) GO TO 50
  99.       DO 40 I=IBEG,JBND
  100.         ISUCC = IORD(I)
  101. C ***JUMP OUT OF DO-LOOP
  102.         IF(ERRMAX.GE.ELIST(ISUCC)) GO TO 60
  103.         IORD(I-1) = ISUCC
  104.    40 CONTINUE
  105.    50 IORD(JBND) = MAXERR
  106.       IORD(JUPBN) = LAST
  107.       GO TO 90
  108. C
  109. C           INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP.
  110. C
  111.    60 IORD(I-1) = MAXERR
  112.       K = JBND
  113.       DO 70 J=I,JBND
  114.         ISUCC = IORD(K)
  115. C ***JUMP OUT OF DO-LOOP
  116.         IF(ERRMIN.LT.ELIST(ISUCC)) GO TO 80
  117.         IORD(K+1) = ISUCC
  118.         K = K-1
  119.    70 CONTINUE
  120.       IORD(I) = LAST
  121.       GO TO 90
  122.    80 IORD(K+1) = LAST
  123. C
  124. C           SET MAXERR AND ERMAX.
  125. C
  126.    90 MAXERR = IORD(NRMAX)
  127.       ERMAX = ELIST(MAXERR)
  128.       RETURN
  129.       END
  130.